home *** CD-ROM | disk | FTP | other *** search
/ Amiga News 96 / Amiga News 96.iso / amig_ad_os / amitex / arexx / formater.amitex < prev    next >
Text File  |  1997-01-19  |  3KB  |  116 lines
  1. /* formater.amitex $VER: 1.00, © R.Florac, 3 janvier 1997 */
  2.  
  3. options results     /* indispensable pour récupérer le résultat des macros */
  4.  
  5. signal on error     /* pour l'interception des erreurs */
  6. signal on syntax
  7.  
  8. 'LOCK(-1)'          /* verrouillage des fenêtres */
  9.  
  10. 'BLOCK(1)'; l1 = result
  11. if l1 <= 0 then
  12.     call marquage_bloc
  13. else do
  14.     'BLOCK(3)'; l2 = result
  15. end
  16.  
  17. mg=getclip(marge_gauche)
  18. md=getclip(marge_droite)
  19. if (mg="" | md="") then call fixer_marges
  20. if (mg<0 | mg>md-30) then call fixer_marges
  21. nbcar=md-mg+1                /* nbre de caractères par ligne */
  22.  
  23. 'TITLE("Formatage en cours...")'
  24. texte=''
  25. do l=l1 to l2
  26.     'READLINE('l')'         /* lecture d'une ligne */
  27.     ligne = result
  28.     ligne=strip(ligne)      /* élimination des espaces de début et de fin */
  29.     texte= texte || ligne
  30.     if l < l2 then texte = texte || ' '
  31. end
  32.  
  33. /* démarquage du bloc */
  34. 'UNMARK(0):GOTO(1,'l1')'
  35.  
  36. position = 1    /* préparation du traitement */
  37.  
  38. do i=1 while position <= length(texte)
  39.     PosFin = lastpos(' ',texte' ', position+nbcar)
  40.     if PosFin > position then
  41.     ligne = substr(texte, position, PosFin-position+1,' ')
  42.     else
  43.     leave
  44.     position = PosFin + 1
  45.     if l1 <= l2 then
  46.     'DELEND(0)'
  47.     else
  48.     'INSLINES(1)'
  49.     'GOTO('mg',LINE)'
  50.     call ecriture(ligne)
  51.     l1 = l1+1
  52.     'IF(LINE<NBLINES,GOTO(1,LINE+1),0)'
  53. end
  54. if l1 <= l2 then 'SUPLINES('l2-l1+1')'
  55. 'TITLE("")'
  56. exit
  57.  
  58. fixer_marges: procedure expose mg md
  59.     cr = '0a'x
  60.     'MESSAGE("Cliquez sur la marge gauche'cr'puis sur la marge droite.'cr'Vous pouvez utiliser'cr'l''ascenseur et les'cr'flèches pour faire défiler'cr'le texte.")'
  61.     'PICKCOL("Cliquez sur la marge gauche")'
  62.     mg=result
  63.     if mg<0 then exit
  64.     'PICKCOL("Cliquez sur la marge droite")'
  65.     md=result
  66.     if mg+20>=md then do
  67.     'MESSAGE("Sélection incorrecte:"+CHR(10)+"opération annulée")'
  68.     exit
  69.     end
  70.     a = setclip(marge_gauche,mg)
  71.     a = setclip(marge_droite,md)
  72.     return
  73. end
  74.  
  75. marquage_bloc: procedure expose l1 l2
  76.     cr = '0a'x
  77.     'REQUEST("Voulez-vous marquer le'||cr||'bloc à formater?")'
  78.     if result=0 then exit
  79.     'MESSAGE("Cliquez sur la ligne de début'cr'puis sur la ligne de fin.'cr'Vous pouvez utiliser'cr'l''ascenseur et les'cr'flèches pour faire défiler'cr'le texte.")'
  80.     'PICKLINE("Cliquez sur la ligne de début")'
  81.     l1=result
  82.     if l1<1 then exit
  83.     'PICKLINE("Cliquez sur la ligne de fin")'
  84.     l2=result
  85.     if l2<1 then exit
  86.     return
  87. end
  88.  
  89. ecriture: procedure
  90.     parse arg ligne
  91.     position=1
  92.     do forever
  93.     position=index(ligne,'"',position)          /* test présence guillemet */
  94.     if position>0 then do
  95.         ligne=insert('"',ligne,position)        /* doublure des guillemets */
  96.         position = position+2            /* passage aux suivants éventuels */
  97.     end
  98.     else do
  99.         'WRITE("'ligne'")'
  100.         return
  101.     end
  102.     end
  103. end
  104.  
  105. /* Traitement des erreurs, interruption du programme */
  106. syntax:
  107. erreur=RC
  108. 'MESSAGE("Script Formater"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  109. 'TITLE("")'
  110. exit
  111.  
  112. error:
  113. 'MESSAGE("Script Formater"+CHR(10)+"Erreur en ligne 'SIGL'")'
  114. 'TITLE("")'
  115. exit
  116.